Visual Basic Toolbox/Visual Basic Toolbox (P.I.E.)(1996).ISO/patchfix/ddefix/ddefix.txt

Internet Message Format | 1995-06-29 | 16.6 KB

Date:  06/29/95
RE:    Correction for program group and item creation
Author: Todd Hardin  with many contributions from Gregg S. Irwin


Description of problem:
    When attempting to create a program group using an existing
    group file name, but a different group name, program manager
    fails silently (or at least there doesn't seem to be a way
    to communicate sucess via DDE with progman.exe).
    The result is that the program manager group with focus is the
    last group the user had given focus to before running your
    setup program.  Since the AddItem command simply add the item to
    the group with focus, your icons end up in unexpected places.

Example of problem:
    Feb 1, 1995 - Client runs setup program.  group name is "Dog Group"
                  Group file name is "DOG.GRP"

    Mar 1, 1995 - Clever person decides to change "Dog Group" to
                  "Cat Group" but leave the file name alone.

    Apr 1, 1995 - Client recieves upgrade from you. When they run the
                  setup they are surprised to find you icons have
                  been placed in "Main Group" (or some other group).

Solution:
    I Should give credit to Gregg S. Irwin for providing examples of
    how to retrieve information about groups and group contents.
    I downloaded DDEPM.ZIP from the MSBASIC forum and found it
    instructive.  Note that I "borrowed" a few functions from
    his code, however there may be a few alterations, so please
    examine closely if you intend to add his routines to your
    setup in addition to this code from me.

    Logic - Check to see if there already exists a group with the
            name I wish to use.  If so then I may move on to
            adding items.

            Check to see if there already exists a group file with
            the same file name I wish to use. (Note that I strip
            off the path, so I don't care where the file resides. This
            may not be the best assumption). If there is a group file
            with my desired filename then retrieve the actual Group Name
            text and use it to add items.

            OK, I know there is not a pre-existing group that I am
            interested in, so it's safe to create my new group.

Disclaimer & Appology:
    Use at your own risk.  This code is still a bit loose.  I was short
    on time and have not added robust error handling. Naming convention
    may be awkward from "borrowing" code from several sources.
    If you clean this up, please post.


'----------------------------------------------------------------------
'>> Important! Remove the setup1.Label and replace with txtLink textbox control
'   A text box can hold a much longer string than a label's caption.
'   In retrieving lists of groups and lists of group contents some
'   strings can get very long.
'----------------------------------------------------------------------


'----------------------------------------------------------------------
'>> Add this to CreateProgManItem just before the ReplaceItem statement.
'   These two ShowGroup commands are necessary to ensure that our group
'   has focus so it will receive the items icon.  Commands as per
'   KB Article Q104943 - @:tlh
    mtxtDDELink.LinkExecute "[ShowGroup(" + grpName$ + ",2)]"
    mtxtDDELink.LinkExecute "[ShowGroup(" + grpName$ + ",1)]"
'----------------------------------------------------------------------


'----------------------------------------------------------------------
'>> Add to Setup1A.FRM  Declarations section:
Dim mtxtDDELink As TextBox  'TextBox for DDE communication
Dim groupName$  'Group name to use with program manager
Dim groupFile$  'Group file name to use with program manager
Const DEFAULTGROUPNAME = "My App Group Title"
Const DEFAULTGROUPFILE = "MYAPP"
'----------------------------------------------------------------------


'----------------------------------------------------------------------
'>> Place near top of Setup1A.FRM  Form_Load
Set mtxtDDELink = Setup1!txtLink  'Text box used for DDE communication
groupName$ = DEFAULTGROUPNAME$
groupFile$ = DEFAULTGROUPFILE$
'----------------------------------------------------------------------


'----------------------------------------------------------------------
'>> Modify the section of setup1.frm  form_load that creates
'   program manager groups and items as follows:
'
'--------------------------------------
' Create program manager group and icon
'--------------------------------------
If Not (ddeChooseGroup%(mtxtDDELink, groupName$, groupFile$)) Then
   GoTo ErrorSetup
End If
CreateProgManGroup mtxtDDELink, groupName$, groupFile$
CreateProgManItem mtxtDDELink, destpath$ + "MYAPP1.EXE", "My App Name 1", groupName$
CreateProgManItem mtxtDDELink, destpath$ + "MYAPP2.EXE", "My App Name 2", groupName$
CreateProgManItem mtxtDDELink, destpath$ + "MYAPP3.EXE", "My App Name 3", groupName$
CreateProgManItem mtxtDDELink, destpath$ + "MYAPP4.EXE", "My App Name 4", groupName$
'----------------------------------------------------------------------



'----------------------------------------------------------------------
'>> Create a new BAS file (I called mine, creatively enough, DDE.BAS)
'----------------------------------------------------------------------
'>>>>>>>>>>>>>>>>>>>>>>>Begin DDE.BAS
Option Explicit
DefInt A-Z

' Used by myParseString
Global Const ERR_ITEMS_TRUNCATED = -2

' LinkMode (forms and controls)
Global Const LINK_NONE = 0      ' 0 - None
Global Const LINK_SOURCE = 1    ' 1 - Source (forms only)
Global Const LINK_AUTOMATIC = 1 ' 1 - Automatic (controls only)
Global Const LINK_MANUAL = 2    ' 2 - Manual (controls only)
Global Const LINK_NOTIFY = 3    ' 3 - Notify (controls only)


Function ddeChooseGroup% (mtxtDDELink As TextBox, grpName$, grpFile$)
   Dim i%
   Dim GetGroups%
   Dim retcode%
   ReDim arrGroups$(0)       'array of group names
   ReDim arrGroupFiles$(0)   'array of group file names (w/o paths)

   On Error GoTo ErrddeChooseGroup


   retcode% = ddepmGetGroups(mtxtDDELink, arrGroups$())
   '
   retcode% = ddepmGetGroupFiles%(mtxtDDELink, arrGroups$(), arrGroupFiles$())
   '
   retcode% = ddeSetGroupNameToUse%(arrGroups$(), arrGroupFiles$(), grpName$, grpFile$)
   '
   ddeChooseGroup% = True

Exit Function

ErrddeChooseGroup:
   MsgBox "Error in retrieving information about program manager groups." & Chr$(10) & Chr$(13) & "Error Number: " & Str$(Err) & Chr$(10) & Chr$(13) & Error$
   Exit Function


End Function


Private Function ddeParseString% (StringIn$, arrOut$(), Delimiter$)
'----------------------------------------------------------
'-- Returns: True as long as we don't bomb out due to
'              a delimiter or String not being passed.
'            ERR_ITEMS_TRUNCATED(-2) if we try to load more
'              elements than exist in the array. If this is
'              the case then some elements will have been
'              loaded properly but some may have been
'              truncated.
'
'-- StringIn$ = The string to parse
'   arrOut$() = The array to fill (should be dynamic as
'               it will be ReDim'ed in this procedure)
'   Delimiter$= The character(s) separating the elements
'               in Stringin$
'----------------------------------------------------------
    Dim LastItemPos%, NextItemPos%
    Dim StartPos%
    Dim ItemLen%
    Dim DelimiterLength%
    Dim NumItems%
    Dim ItemNum%
    Dim bGetLastItem%


    If Len(StringIn$) = 0 Then
        ddeParseString% = False
        Exit Function
    End If

    DelimiterLength% = Len(Delimiter$)
    If DelimiterLength% = 0 Then
        ddeParseString% = False
        Exit Function
    End If

    '@tlh
    'StringIn$ = Trim(StringIn$)

    'On Error Resume Next
    On Error GoTo ErrParse
        '-----------------------------------------------------
        '-- First time through we're just counting
        '-----------------------------------------------------
        NextItemPos% = InStr(StringIn$, Delimiter$)
        While NextItemPos%
            NumItems% = NumItems% + 1
            StartPos% = NextItemPos% + DelimiterLength%
            NextItemPos% = InStr(StartPos%, StringIn$, Delimiter$)
        Wend

        '-----------------------------------------------------
        '-- We now know how many items are in the string so
        '   we can initialize our array. The exception to this
        '   would be if the Delimiter is the last thing in the
        '   string in which case we need to ReDim to one less
        '   item than we counted.
        '-----------------------------------------------------
        If StartPos% <> Len(StringIn$) + 1 Then
            ReDim arrOut$(NumItems%)
            '-- Set a flag so we know to get the last element
            bGetLastItem% = True
        Else 'The string ended in with the delimiter :@tlh
            '@Issue:tlh  revise this code later.  Would be better
            '            to repeatedly trim delimiter off end of
            '            string until it's gone.
            '@:tlh Seems to be a logic error later on in loading the
            '   array, so I will fix by cutting delimiter off
            '   the end of the string and in effect normalizing these
            '   two cases to a single one.
            ReDim arrOut$(NumItems% - 1)
            StringIn$ = Mid$(StringIn$, 1, (Len(StringIn$) - DelimiterLength%))
            bGetLastItem% = True
        End If

        '-- This needs to be initialized
        LastItemPos% = 1

        '-----------------------------------------------------
        '-- Now it's for real. Get the items from the string.
        '-----------------------------------------------------
        NextItemPos% = InStr(StringIn$, Delimiter$)
        While NextItemPos%
            StartPos% = LastItemPos%
            ItemLen% = (NextItemPos% - LastItemPos%)

            arrOut$(ItemNum%) = Mid$(StringIn$, StartPos%, ItemLen%)
            ItemNum% = ItemNum% + 1
            '
            If ItemNum% > UBound(arrOut$) Then
                ddeParseString% = ERR_ITEMS_TRUNCATED
                Exit Function
            End If

            LastItemPos% = NextItemPos% + DelimiterLength%
            NextItemPos% = InStr(LastItemPos%, StringIn$, Delimiter$)
        Wend

        '-- If the bGetLastItem% flag is on then
        '   we have one more element to get.
        If bGetLastItem% Then
            arrOut$(ItemNum%) = Mid$(StringIn$, LastItemPos%)
        End If

    'On Error GoTo 0

    ddeParseString% = True

Exit Function

ErrParse:
   MsgBox "Error: " & Str$(Err) & " : " & Error$
   Exit Function


End Function


Function ddepmGetGroupFiles% (txtLink As TextBox, arrGroups$(), arrGroupFiles$())
   Dim PrevLinkTimeout%
   Dim PropertyDelimiter$
   Dim GroupItemInfo$
   Dim i%
   Dim myStartPos%
   Dim myEndPos%
   Dim myGrpFile$
   ReDim arrGroupFiles$(UBound(arrGroups$))  'We expect same number of files

   On Error GoTo myddepmGroupInfoError

   'Initialize Variables
   PropertyDelimiter$ = Chr$(44)  ' Comma ","

   'Preserve previous Link settings
   PrevLinkTimeout% = txtLink.LinkTimeout

   If UBound(arrGroups$) = 0 Then 'this is an empter array!
      ddepmGetGroupFiles% = False  'function failed, nothing to process
      Exit Function
   End If

   'Establish DDE Link settings
   txtLink.LinkTopic = "ProgMan|Progman"  'program manager is the link topic.
   txtLink.LinkMode = LINK_MANUAL
   txtLink.LinkTimeout = 100

   'Ask progman for group info for each group name in the arrGroups$ array
   For i% = 0 To UBound(arrGroups$)
      txtLink.LinkTopic = "ProgMan|Progman"  'program manager is the link topic.
      txtLink.LinkMode = LINK_MANUAL
      txtLink.LinkTimeout = 100
      txtLink.LinkItem = arrGroups$(i%)      'group name to retrieve info for.
      txtLink.LinkRequest                    'returned in txtLink.Text
      GroupItemInfo$ = txtLink.Text

      'second entry in delimited list is the fully qualified group file name.
      myStartPos% = (InStr(1, GroupItemInfo$, PropertyDelimiter$)) + 1
      myEndPos% = InStr(myStartPos%, GroupItemInfo$, PropertyDelimiter$)
      myGrpFile$ = Mid$(GroupItemInfo$, myStartPos%, myEndPos% - myStartPos%)

      'extract the file name only and load into arrGroupFiles$ array.
      arrGroupFiles$(i%) = ExtractName$(myGrpFile$, False)
      Debug.Print Str$(i%) & " : " & arrGroupFiles$(i%)
   Next

   '---------------------------------------------------------
   'Reset DDE Link properties
   '---------------------------------------------------------
   txtLink.LinkTimeout = PrevLinkTimeout%
   txtLink.LinkMode = 0


ddepmGetGroupFiles% = True
Exit Function

myddepmGroupInfoError:
   MsgBox "Problem retrieving program group information." & Chr$(10) & Chr$(13) & "Error num: " & Str$(Err) & Chr$(10) & Chr$(13) & "  Error is: " & Error$
   ddepmGetGroupFiles% = False  'function failed
   Exit Function

End Function

Function ddepmGetGroups% (txtLink As TextBox, arrGroups$())
'txtLink As TextBox
'---------------------------------------------------------
'-- Returns: True if all goes well.
'            False if any DDE errors occur. If this is the
'             case then no group names will have been
'             loaded.
'            ERR_ITEMS_TRUNCATED(-2) if an error occurs
'             while parsing the Group Names.
'
'-- NOTE:    Even if errors occur(-2) some GroupNames may
'            have been loaded successfully into the array.
'
'-- Returns arrGroups$() filled with all the available
'   groups in ProgMan. The array is 0 based so the calling
'   procedure should read from 0 to Ubound(arrGroups$) -1
'   in order to read all the group names.
'
'-- arrGroups$() should be a dynamic string array. This
'   procedure will resize it as necessary.
'---------------------------------------------------------
    Dim i%
    Dim OldLinkTimeout%
    Dim GroupList$
    Dim Delimiter$
    Dim NumGroups%
    Dim CRLFPos%
    Dim GroupsParsedOK%

    OldLinkTimeout% = txtLink.LinkTimeout

    '---------------------------------------------------------
    '-- Set LinkTopic to PROGRAM MANAGER
    '---------------------------------------------------------
    txtLink.LinkTopic = "ProgMan|Progman"
    txtLink.LinkMode = LINK_MANUAL
    txtLink.LinkTimeout = 100

    On Error GoTo myddepmGetGroupsError
        '---------------------------------------------------------
        '-- Ask for the program manager group information
        '   (returned in txtLink.text)
        '---------------------------------------------------------
        txtLink.LinkItem = "PROGMAN"
        txtLink.LinkRequest

        '-- Set return value
        GroupList$ = txtLink.Text

    On Error GoTo 0

    '---------------------------------------------------------
    '-- Reset properties
    '---------------------------------------------------------
    txtLink.LinkTimeout = OldLinkTimeout%
    txtLink.LinkMode = 0


    '---------------------------------------------------------
    '-- Load the array with the names of the groups
    '---------------------------------------------------------
    Delimiter$ = Chr$(13) & Chr$(10)
    GroupsParsedOK% = ddeParseString%(GroupList$, arrGroups$(), Delimiter$)
    If GroupsParsedOK% = True Then
        ddepmGetGroups% = True
    ElseIf GroupsParsedOK% = ERR_ITEMS_TRUNCATED Then
        ddepmGetGroups% = ERR_ITEMS_TRUNCATED
    End If


myddepmGetGroupsExit:
    Screen.MousePointer = DEFAULT
    On Error GoTo 0
    Exit Function


myddepmGetGroupsError:
    ddepmGetGroups% = False
    MsgBox "An error occured in retrieving program manager group names." & Chr$(10) & Chr$(13) & "Error: " & Error$
    Resume myddepmGetGroupsExit


End Function

Function ddeSetGroupNameToUse% (arrGroups$(), arrGroupFiles$(), grpName$, grpFile$)
   Dim i%
   Dim arraySize%
   Dim ffound%  'flag

   On Error GoTo ErmySetGroupNameToUse

   'Initialize variables
   arraySize% = UBound(arrGroups$)
   ffound% = False


   i% = -1
   While (Not (ffound%)) And (i% < arraySize%)
      i% = i% + 1
      If (arrGroups$(i%) = grpName$) Or (UCase$(grpFile$ & ".GRP") = UCase$(arrGroupFiles$(i%))) Then
         ffound% = True
         grpName$ = arrGroups$(i%)
      End If
   Wend
   '



Exit Function
ErmySetGroupNameToUse:
   MsgBox "Error: " & Str$(Err) & " : " & Error$
   Exit Function

End Function
'>>>>>>>>>>>>>>>>>>>>>>>End DDE.BAS